;;;; 2009-01-13 12:54:55
;;;; Behold, the power of lisp!

(in-package :stats)

(defun sum (lst &optional (i 1) n) 
  (reduce #'+ lst :start (- i 1) :end n))

(defun factorial (n)
  (if (< n 0)
      "undef"
      (if (eql n 0)
          1
          (* n (factorial (- n 1))))))

(defun unordered-comb (m n)
  (/ (factorial m) (* (factorial n) (factorial (- m n)))))

(defun ordered-perm (m n)
  (/ (factorial m) (factorial (- m n))))
  
(defun mean (lst) 
  (/ (sum lst) (length lst)))

(defun square (x)
  (* x x))

(defun variance (lst)
  (let ((y (mean lst))) 
    (/ (reduce 
        (lambda (a b) 
          (+ (square (- y b)) a))
        lst)
       (length lst))))

(defun occurs (e lst)
  (if (car lst)
      (if (eql e (car lst)) 
          (+ 1 (occurs e (cdr lst)))
          (occurs e (cdr lst)))
      0))

(defun z-score (i data)
  ; zi = (xi - M) / S
  (/ (- (nth i data) (mean data))) (sqrt (variance data)))

(defun z-dist (mean dev)
  (lambda (z)
    (/ (- z mean) dev)))

(defun expected-val-geometric (p n)
  (let ((inv (- 1 p)))
    (labels ((inner (i)
               (if (> i 0)
                   (+ (* (* i (expt p (- i 1))) inv) (inner (- i 1)))
                   0)))
      (inner n))))

(defun prob-dist (v-map s)
  ; v-map (1 5 10 ... r), sums to total sample size
  (if (car v-map)
      (cons (/ (car v-map) s) (prob-dist (cdr v-map) s))
      '()))

(defun mean-pv (pv v)
  (if (and (car pv) (car v))
      (+ (* (car pv) (car v)) (mean-pv (cdr pv) (cdr v)))
      0))

(defun variance-pv (pv v)
  (labels ((inner (pv v)
             (if (and (car pv) (car v))
                 (+ (* (car pv) (square (car v))) (inner (cdr pv) (cdr v)))
                 0)))
    (- (inner pv v) (square (mean-pv pv v)))))

(defun binomial-dist (N p)
  (lambda (r) 
    (* (unordered-comb N r) (expt p r) (expt (- 1 p) (- N r)))))

(defun frequency (e lst)
  (/ (occurs e lst) (length lst)))

(defun freq-dist (pick in-set)
  (if (car pick)
      (cons (list (car pick) (occurs (car pick) in-set)) (freq-dist (cdr pick) in-set))
      '()))

(defun freq-dist-all (in-set)
  (freq-dist (remove-duplicates in-set) in-set))

(defun area-triangle (base height)
  (float (* base height 0.5)))

(defun area-trapezoid (top base height)
  (float (* (+ top base) 0.5 height)))
